home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / tkfbox.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  52.7 KB  |  1,965 lines

  1. # tkfbox.tcl --
  2. #
  3. #    Implements the "TK" standard file selection dialog box. This
  4. #    dialog box is used on the Unix platforms whenever the tk_strictMotif
  5. #    flag is not set.
  6. #
  7. #    The "TK" standard file selection dialog box is similar to the
  8. #    file selection dialog box on Win95(TM). The user can navigate
  9. #    the directories by clicking on the folder icons or by
  10. #    selecting the "Directory" option menu. The user can select
  11. #    files by clicking on the file icons or by entering a filename
  12. #    in the "Filename:" entry.
  13. #
  14. # RCS: @(#) $Id: tkfbox.tcl,v 1.68.2.3 2009/10/22 10:27:58 dkf Exp $
  15. #
  16. # Copyright (c) 1994-1998 Sun Microsystems, Inc.
  17. #
  18. # See the file "license.terms" for information on usage and redistribution
  19. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  20. #
  21.  
  22. package require Ttk
  23.  
  24. #----------------------------------------------------------------------
  25. #
  26. #              I C O N   L I S T
  27. #
  28. # This is a pseudo-widget that implements the icon list inside the
  29. # ::tk::dialog::file:: dialog box.
  30. #
  31. #----------------------------------------------------------------------
  32.  
  33. # ::tk::IconList --
  34. #
  35. #    Creates an IconList widget.
  36. #
  37. proc ::tk::IconList {w args} {
  38.     IconList_Config $w $args
  39.     IconList_Create $w
  40. }
  41.  
  42. proc ::tk::IconList_Index {w i} {
  43.     upvar #0 ::tk::$w data ::tk::$w:itemList itemList
  44.     if {![info exists data(list)]} {
  45.     set data(list) {}
  46.     }
  47.     switch -regexp -- $i {
  48.     "^-?[0-9]+$" {
  49.         if {$i < 0} {
  50.         set i 0
  51.         }
  52.         if {$i >= [llength $data(list)]} {
  53.         set i [expr {[llength $data(list)] - 1}]
  54.         }
  55.         return $i
  56.     }
  57.     "^active$" {
  58.         return $data(index,active)
  59.     }
  60.     "^anchor$" {
  61.         return $data(index,anchor)
  62.     }
  63.     "^end$" {
  64.         return [llength $data(list)]
  65.     }
  66.     "@-?[0-9]+,-?[0-9]+" {
  67.         foreach {x y} [scan $i "@%d,%d"] {
  68.         break
  69.         }
  70.         set item [$data(canvas) find closest \
  71.             [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]]
  72.         return [lindex [$data(canvas) itemcget $item -tags] 1]
  73.     }
  74.     }
  75. }
  76.  
  77. proc ::tk::IconList_Selection {w op args} {
  78.     upvar ::tk::$w data
  79.     switch -exact -- $op {
  80.     "anchor" {
  81.         if {[llength $args] == 1} {
  82.         set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]]
  83.         } else {
  84.         return $data(index,anchor)
  85.         }
  86.     }
  87.     "clear" {
  88.         if {[llength $args] == 2} {
  89.         foreach {first last} $args {
  90.             break
  91.         }
  92.         } elseif {[llength $args] == 1} {
  93.         set first [set last [lindex $args 0]]
  94.         } else {
  95.         error "wrong # args: should be [lindex [info level 0] 0] path\
  96.             clear first ?last?"
  97.         }
  98.         set first [IconList_Index $w $first]
  99.         set last [IconList_Index $w $last]
  100.         if {$first > $last} {
  101.         set tmp $first
  102.         set first $last
  103.         set last $tmp
  104.         }
  105.         set ind 0
  106.         foreach item $data(selection) {
  107.         if { $item >= $first } {
  108.             set first $ind
  109.             break
  110.         }
  111.         incr ind
  112.         }
  113.         set ind [expr {[llength $data(selection)] - 1}]
  114.         for {} {$ind >= 0} {incr ind -1} {
  115.         set item [lindex $data(selection) $ind]
  116.         if { $item <= $last } {
  117.             set last $ind
  118.             break
  119.         }
  120.         }
  121.  
  122.         if { $first > $last } {
  123.         return
  124.         }
  125.         set data(selection) [lreplace $data(selection) $first $last]
  126.         event generate $w <<ListboxSelect>>
  127.         IconList_DrawSelection $w
  128.     }
  129.     "includes" {
  130.         set index [lsearch -exact $data(selection) [lindex $args 0]]
  131.         return [expr {$index != -1}]
  132.     }
  133.     "set" {
  134.         if { [llength $args] == 2 } {
  135.         foreach {first last} $args {
  136.             break
  137.         }
  138.         } elseif { [llength $args] == 1 } {
  139.         set last [set first [lindex $args 0]]
  140.         } else {
  141.         error "wrong # args: should be [lindex [info level 0] 0] path\
  142.             set first ?last?"
  143.         }
  144.  
  145.         set first [IconList_Index $w $first]
  146.         set last [IconList_Index $w $last]
  147.         if { $first > $last } {
  148.         set tmp $first
  149.         set first $last
  150.         set last $tmp
  151.         }
  152.         for {set i $first} {$i <= $last} {incr i} {
  153.         lappend data(selection) $i
  154.         }
  155.         set data(selection) [lsort -integer -unique $data(selection)]
  156.         event generate $w <<ListboxSelect>>
  157.         IconList_DrawSelection $w
  158.     }
  159.     }
  160. }
  161.  
  162. proc ::tk::IconList_CurSelection {w} {
  163.     upvar ::tk::$w data
  164.     return $data(selection)
  165. }
  166.  
  167. proc ::tk::IconList_DrawSelection {w} {
  168.     upvar ::tk::$w data
  169.     upvar ::tk::$w:itemList itemList
  170.  
  171.     $data(canvas) delete selection
  172.     $data(canvas) itemconfigure selectionText -fill black
  173.     $data(canvas) dtag selectionText
  174.     set cbg [ttk::style lookup TEntry -selectbackground focus]
  175.     set cfg [ttk::style lookup TEntry -selectforeground focus]
  176.     foreach item $data(selection) {
  177.     set rTag [lindex [lindex $data(list) $item] 2]
  178.     foreach {iTag tTag text serial} $itemList($rTag) {
  179.         break
  180.     }
  181.  
  182.     set bbox [$data(canvas) bbox $tTag]
  183.     $data(canvas) create rect $bbox -fill $cbg -outline $cbg \
  184.         -tags selection
  185.     $data(canvas) itemconfigure $tTag -fill $cfg -tags selectionText
  186.     }
  187.     $data(canvas) lower selection
  188.     return
  189. }
  190.  
  191. proc ::tk::IconList_Get {w item} {
  192.     upvar ::tk::$w data
  193.     upvar ::tk::$w:itemList itemList
  194.     set rTag [lindex [lindex $data(list) $item] 2]
  195.     foreach {iTag tTag text serial} $itemList($rTag) {
  196.     break
  197.     }
  198.     return $text
  199. }
  200.  
  201. # ::tk::IconList_Config --
  202. #
  203. #    Configure the widget variables of IconList, according to the command
  204. #    line arguments.
  205. #
  206. proc ::tk::IconList_Config {w argList} {
  207.  
  208.     # 1: the configuration specs
  209.     #
  210.     set specs {
  211.     {-command "" "" ""}
  212.     {-multiple "" "" "0"}
  213.     }
  214.  
  215.     # 2: parse the arguments
  216.     #
  217.     tclParseConfigSpec ::tk::$w $specs "" $argList
  218. }
  219.  
  220. # ::tk::IconList_Create --
  221. #
  222. #    Creates an IconList widget by assembling a canvas widget and a
  223. #    scrollbar widget. Sets all the bindings necessary for the IconList's
  224. #    operations.
  225. #
  226. proc ::tk::IconList_Create {w} {
  227.     upvar ::tk::$w data
  228.  
  229.     ttk::frame $w
  230.     ttk::entry $w.cHull -takefocus 0 -cursor {}
  231.     set data(sbar)   [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0]
  232.     catch {$data(sbar) configure -highlightthickness 0}
  233.     set data(canvas) [canvas $w.cHull.canvas -highlightthick 0 \
  234.         -width 400 -height 120 -takefocus 1 -background white]
  235.     pack $data(sbar) -side bottom -fill x -padx 2 -in $w.cHull -pady {0 2}
  236.     pack $data(canvas) -expand yes -fill both -padx 2 -pady {2 0}
  237.     pack $w.cHull -expand yes -fill both -ipadx 2 -ipady 2
  238.  
  239.     $data(sbar) configure -command [list $data(canvas) xview]
  240.     $data(canvas) configure -xscrollcommand [list $data(sbar) set]
  241.  
  242.     # Initializes the max icon/text width and height and other variables
  243.     #
  244.     set data(maxIW) 1
  245.     set data(maxIH) 1
  246.     set data(maxTW) 1
  247.     set data(maxTH) 1
  248.     set data(numItems) 0
  249.     set data(noScroll) 1
  250.     set data(selection) {}
  251.     set data(index,anchor) ""
  252.     set fg [option get $data(canvas) foreground Foreground]
  253.     if {$fg eq ""} {
  254.     set data(fill) black
  255.     } else {
  256.     set data(fill) $fg
  257.     }
  258.  
  259.     # Creates the event bindings.
  260.     #
  261.     bind $data(canvas) <Configure>    [list tk::IconList_Arrange $w]
  262.  
  263.     bind $data(canvas) <1>        [list tk::IconList_Btn1 $w %x %y]
  264.     bind $data(canvas) <B1-Motion>    [list tk::IconList_Motion1 $w %x %y]
  265.     bind $data(canvas) <B1-Leave>    [list tk::IconList_Leave1 $w %x %y]
  266.     bind $data(canvas) <Control-1>    [list tk::IconList_CtrlBtn1 $w %x %y]
  267.     bind $data(canvas) <Shift-1>    [list tk::IconList_ShiftBtn1 $w %x %y]
  268.     bind $data(canvas) <B1-Enter>    [list tk::CancelRepeat]
  269.     bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat]
  270.     bind $data(canvas) <Double-ButtonRelease-1> \
  271.         [list tk::IconList_Double1 $w %x %y]
  272.  
  273.     bind $data(canvas) <Control-B1-Motion> {;}
  274.     bind $data(canvas) <Shift-B1-Motion> \
  275.         [list tk::IconList_ShiftMotion1 $w %x %y]
  276.  
  277.     bind $data(canvas) <Up>        [list tk::IconList_UpDown $w -1]
  278.     bind $data(canvas) <Down>        [list tk::IconList_UpDown $w  1]
  279.     bind $data(canvas) <Left>        [list tk::IconList_LeftRight $w -1]
  280.     bind $data(canvas) <Right>        [list tk::IconList_LeftRight $w  1]
  281.     bind $data(canvas) <Return>        [list tk::IconList_ReturnKey $w]
  282.     bind $data(canvas) <KeyPress>    [list tk::IconList_KeyPress $w %A]
  283.     bind $data(canvas) <Control-KeyPress> ";"
  284.     bind $data(canvas) <Alt-KeyPress>    ";"
  285.  
  286.     bind $data(canvas) <FocusIn>    [list tk::IconList_FocusIn $w]
  287.     bind $data(canvas) <FocusOut>    [list tk::IconList_FocusOut $w]
  288.  
  289.     return $w
  290. }
  291.  
  292. # ::tk::IconList_AutoScan --
  293. #
  294. # This procedure is invoked when the mouse leaves an entry window
  295. # with button 1 down.  It scrolls the window up, down, left, or
  296. # right, depending on where the mouse left the window, and reschedules
  297. # itself as an "after" command so that the window continues to scroll until
  298. # the mouse moves back into the window or the mouse button is released.
  299. #
  300. # Arguments:
  301. # w -        The IconList window.
  302. #
  303. proc ::tk::IconList_AutoScan {w} {
  304.     upvar ::tk::$w data
  305.     variable ::tk::Priv
  306.  
  307.     if {![winfo exists $w]} return
  308.     set x $Priv(x)
  309.     set y $Priv(y)
  310.  
  311.     if {$data(noScroll)} {
  312.     return
  313.     }
  314.     if {$x >= [winfo width $data(canvas)]} {
  315.     $data(canvas) xview scroll 1 units
  316.     } elseif {$x < 0} {
  317.     $data(canvas) xview scroll -1 units
  318.     } elseif {$y >= [winfo height $data(canvas)]} {
  319.     # do nothing
  320.     } elseif {$y < 0} {
  321.     # do nothing
  322.     } else {
  323.     return
  324.     }
  325.  
  326.     IconList_Motion1 $w $x $y
  327.     set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]]
  328. }
  329.  
  330. # Deletes all the items inside the canvas subwidget and reset the IconList's
  331. # state.
  332. #
  333. proc ::tk::IconList_DeleteAll {w} {
  334.     upvar ::tk::$w data
  335.     upvar ::tk::$w:itemList itemList
  336.  
  337.     $data(canvas) delete all
  338.     unset -nocomplain data(selected) data(rect) data(list) itemList
  339.     set data(maxIW) 1
  340.     set data(maxIH) 1
  341.     set data(maxTW) 1
  342.     set data(maxTH) 1
  343.     set data(numItems) 0
  344.     set data(noScroll) 1
  345.     set data(selection) {}
  346.     set data(index,anchor) ""
  347.     $data(sbar) set 0.0 1.0
  348.     $data(canvas) xview moveto 0
  349. }
  350.  
  351. # Adds an icon into the IconList with the designated image and text
  352. #
  353. proc ::tk::IconList_Add {w image items} {
  354.     upvar ::tk::$w data
  355.     upvar ::tk::$w:itemList itemList
  356.     upvar ::tk::$w:textList textList
  357.  
  358.     foreach text $items {
  359.     set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \
  360.         -tags [list icon $data(numItems) item$data(numItems)]]
  361.     set tTag [$data(canvas) create text  0 0 -text  $text  -anchor nw \
  362.         -font $data(font) -fill $data(fill) \
  363.         -tags [list text $data(numItems) item$data(numItems)]]
  364.     set rTag [$data(canvas) create rect  0 0 0 0 -fill "" -outline "" \
  365.         -tags [list rect $data(numItems) item$data(numItems)]]
  366.  
  367.     foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] {
  368.         break
  369.     }
  370.     set iW [expr {$x2 - $x1}]
  371.     set iH [expr {$y2 - $y1}]
  372.     if {$data(maxIW) < $iW} {
  373.         set data(maxIW) $iW
  374.     }
  375.     if {$data(maxIH) < $iH} {
  376.         set data(maxIH) $iH
  377.     }
  378.  
  379.     foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] {
  380.         break
  381.     }
  382.     set tW [expr {$x2 - $x1}]
  383.     set tH [expr {$y2 - $y1}]
  384.     if {$data(maxTW) < $tW} {
  385.         set data(maxTW) $tW
  386.     }
  387.     if {$data(maxTH) < $tH} {
  388.         set data(maxTH) $tH
  389.     }
  390.  
  391.     lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \
  392.         $tH $data(numItems)]
  393.     set itemList($rTag) [list $iTag $tTag $text $data(numItems)]
  394.     set textList($data(numItems)) [string tolower $text]
  395.     incr data(numItems)
  396.     }
  397. }
  398.  
  399. # Places the icons in a column-major arrangement.
  400. #
  401. proc ::tk::IconList_Arrange {w} {
  402.     upvar ::tk::$w data
  403.  
  404.     if {![info exists data(list)]} {
  405.     if {[info exists data(canvas)] && [winfo exists $data(canvas)]} {
  406.         set data(noScroll) 1
  407.         $data(sbar) configure -command ""
  408.     }
  409.     return
  410.     }
  411.  
  412.     set W [winfo width  $data(canvas)]
  413.     set H [winfo height $data(canvas)]
  414.     set pad [expr {[$data(canvas) cget -highlightthickness] + \
  415.         [$data(canvas) cget -bd]}]
  416.     if {$pad < 2} {
  417.     set pad 2
  418.     }
  419.  
  420.     incr W -[expr {$pad*2}]
  421.     incr H -[expr {$pad*2}]
  422.  
  423.     set dx [expr {$data(maxIW) + $data(maxTW) + 8}]
  424.     if {$data(maxTH) > $data(maxIH)} {
  425.     set dy $data(maxTH)
  426.     } else {
  427.     set dy $data(maxIH)
  428.     }
  429.     incr dy 2
  430.     set shift [expr {$data(maxIW) + 4}]
  431.  
  432.     set x [expr {$pad * 2}]
  433.     set y [expr {$pad * 1}] ; # Why * 1 ?
  434.     set usedColumn 0
  435.     foreach sublist $data(list) {
  436.     set usedColumn 1
  437.     foreach {iTag tTag rTag iW iH tW tH} $sublist {
  438.         break
  439.     }
  440.  
  441.     set i_dy [expr {($dy - $iH)/2}]
  442.     set t_dy [expr {($dy - $tH)/2}]
  443.  
  444.     $data(canvas) coords $iTag $x                    [expr {$y + $i_dy}]
  445.     $data(canvas) coords $tTag [expr {$x + $shift}]  [expr {$y + $t_dy}]
  446.     $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}]
  447.  
  448.     incr y $dy
  449.     if {($y + $dy) > $H} {
  450.         set y [expr {$pad * 1}] ; # *1 ?
  451.         incr x $dx
  452.         set usedColumn 0
  453.     }
  454.     }
  455.  
  456.     if {$usedColumn} {
  457.     set sW [expr {$x + $dx}]
  458.     } else {
  459.     set sW $x
  460.     }
  461.  
  462.     if {$sW < $W} {
  463.     $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
  464.     $data(sbar) configure -command ""
  465.     $data(canvas) xview moveto 0
  466.     set data(noScroll) 1
  467.     } else {
  468.     $data(canvas) configure -scrollregion [list $pad $pad $sW $H]
  469.     $data(sbar) configure -command [list $data(canvas) xview]
  470.     set data(noScroll) 0
  471.     }
  472.  
  473.     set data(itemsPerColumn) [expr {($H-$pad)/$dy}]
  474.     if {$data(itemsPerColumn) < 1} {
  475.     set data(itemsPerColumn) 1
  476.     }
  477.  
  478.     IconList_DrawSelection $w
  479. }
  480.  
  481. # Gets called when the user invokes the IconList (usually by double-clicking
  482. # or pressing the Return key).
  483. #
  484. proc ::tk::IconList_Invoke {w} {
  485.     upvar ::tk::$w data
  486.  
  487.     if {$data(-command) ne "" && [llength $data(selection)]} {
  488.     uplevel #0 $data(-command)
  489.     }
  490. }
  491.  
  492. # ::tk::IconList_See --
  493. #
  494. #    If the item is not (completely) visible, scroll the canvas so that
  495. #    it becomes visible.
  496. proc ::tk::IconList_See {w rTag} {
  497.     upvar ::tk::$w data
  498.     upvar ::tk::$w:itemList itemList
  499.  
  500.     if {$data(noScroll)} {
  501.     return
  502.     }
  503.     set sRegion [$data(canvas) cget -scrollregion]
  504.     if {$sRegion eq ""} {
  505.     return
  506.     }
  507.  
  508.     if { $rTag < 0 || $rTag >= [llength $data(list)] } {
  509.     return
  510.     }
  511.  
  512.     set bbox [$data(canvas) bbox item$rTag]
  513.     set pad [expr {[$data(canvas) cget -highlightthickness] + \
  514.         [$data(canvas) cget -bd]}]
  515.  
  516.     set x1 [lindex $bbox 0]
  517.     set x2 [lindex $bbox 2]
  518.     incr x1 -[expr {$pad * 2}]
  519.     incr x2 -[expr {$pad * 1}] ; # *1 ?
  520.  
  521.     set cW [expr {[winfo width $data(canvas)] - $pad*2}]
  522.  
  523.     set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}]
  524.     set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}]
  525.     set oldDispX $dispX
  526.  
  527.     # check if out of the right edge
  528.     #
  529.     if {($x2 - $dispX) >= $cW} {
  530.     set dispX [expr {$x2 - $cW}]
  531.     }
  532.     # check if out of the left edge
  533.     #
  534.     if {($x1 - $dispX) < 0} {
  535.     set dispX $x1
  536.     }
  537.  
  538.     if {$oldDispX ne $dispX} {
  539.     set fraction [expr {double($dispX)/double($scrollW)}]
  540.     $data(canvas) xview moveto $fraction
  541.     }
  542. }
  543.  
  544. proc ::tk::IconList_Btn1 {w x y} {
  545.     upvar ::tk::$w data
  546.  
  547.     focus $data(canvas)
  548.     set i [IconList_Index $w @$x,$y]
  549.     if {$i eq ""} {
  550.     return
  551.     }
  552.     IconList_Selection $w clear 0 end
  553.     IconList_Selection $w set $i
  554.     IconList_Selection $w anchor $i
  555. }
  556.  
  557. proc ::tk::IconList_CtrlBtn1 {w x y} {
  558.     upvar ::tk::$w data
  559.  
  560.     if { $data(-multiple) } {
  561.     focus $data(canvas)
  562.     set i [IconList_Index $w @$x,$y]
  563.     if {$i eq ""} {
  564.         return
  565.     }
  566.     if { [IconList_Selection $w includes $i] } {
  567.         IconList_Selection $w clear $i
  568.     } else {
  569.         IconList_Selection $w set $i
  570.         IconList_Selection $w anchor $i
  571.     }
  572.     }
  573. }
  574.  
  575. proc ::tk::IconList_ShiftBtn1 {w x y} {
  576.     upvar ::tk::$w data
  577.  
  578.     if { $data(-multiple) } {
  579.     focus $data(canvas)
  580.     set i [IconList_Index $w @$x,$y]
  581.     if {$i eq ""} {
  582.         return
  583.     }
  584.     if {[IconList_Index $w anchor] eq ""} {
  585.         IconList_Selection $w anchor $i
  586.     }
  587.     IconList_Selection $w clear 0 end
  588.     IconList_Selection $w set anchor $i
  589.     }
  590. }
  591.  
  592. # Gets called on button-1 motions
  593. #
  594. proc ::tk::IconList_Motion1 {w x y} {
  595.     variable ::tk::Priv
  596.     set Priv(x) $x
  597.     set Priv(y) $y
  598.     set i [IconList_Index $w @$x,$y]
  599.     if {$i eq ""} {
  600.     return
  601.     }
  602.     IconList_Selection $w clear 0 end
  603.     IconList_Selection $w set $i
  604. }
  605.  
  606. proc ::tk::IconList_ShiftMotion1 {w x y} {
  607.     upvar ::tk::$w data
  608.     variable ::tk::Priv
  609.     set Priv(x) $x
  610.     set Priv(y) $y
  611.     set i [IconList_Index $w @$x,$y]
  612.     if {$i eq ""} {
  613.     return
  614.     }
  615.     IconList_Selection $w clear 0 end
  616.     IconList_Selection $w set anchor $i
  617. }
  618.  
  619. proc ::tk::IconList_Double1 {w x y} {
  620.     upvar ::tk::$w data
  621.  
  622.     if {[llength $data(selection)]} {
  623.     IconList_Invoke $w
  624.     }
  625. }
  626.  
  627. proc ::tk::IconList_ReturnKey {w} {
  628.     IconList_Invoke $w
  629. }
  630.  
  631. proc ::tk::IconList_Leave1 {w x y} {
  632.     variable ::tk::Priv
  633.  
  634.     set Priv(x) $x
  635.     set Priv(y) $y
  636.     IconList_AutoScan $w
  637. }
  638.  
  639. proc ::tk::IconList_FocusIn {w} {
  640.     upvar ::tk::$w data
  641.  
  642.     $w.cHull state focus
  643.     if {![info exists data(list)]} {
  644.     return
  645.     }
  646.  
  647.     if {[llength $data(selection)]} {
  648.     IconList_DrawSelection $w
  649.     }
  650. }
  651.  
  652. proc ::tk::IconList_FocusOut {w} {
  653.     $w.cHull state !focus
  654.     IconList_Selection $w clear 0 end
  655. }
  656.  
  657. # ::tk::IconList_UpDown --
  658. #
  659. # Moves the active element up or down by one element
  660. #
  661. # Arguments:
  662. # w -        The IconList widget.
  663. # amount -    +1 to move down one item, -1 to move back one item.
  664. #
  665. proc ::tk::IconList_UpDown {w amount} {
  666.     upvar ::tk::$w data
  667.  
  668.     if {![info exists data(list)]} {
  669.     return
  670.     }
  671.  
  672.     set curr [tk::IconList_CurSelection $w]
  673.     if { [llength $curr] == 0 } {
  674.     set i 0
  675.     } else {
  676.     set i [tk::IconList_Index $w anchor]
  677.     if {$i eq ""} {
  678.         return
  679.     }
  680.     incr i $amount
  681.     }
  682.     IconList_Selection $w clear 0 end
  683.     IconList_Selection $w set $i
  684.     IconList_Selection $w anchor $i
  685.     IconList_See $w $i
  686. }
  687.  
  688. # ::tk::IconList_LeftRight --
  689. #
  690. # Moves the active element left or right by one column
  691. #
  692. # Arguments:
  693. # w -        The IconList widget.
  694. # amount -    +1 to move right one column, -1 to move left one column.
  695. #
  696. proc ::tk::IconList_LeftRight {w amount} {
  697.     upvar ::tk::$w data
  698.  
  699.     if {![info exists data(list)]} {
  700.     return
  701.     }
  702.  
  703.     set curr [IconList_CurSelection $w]
  704.     if { [llength $curr] == 0 } {
  705.     set i 0
  706.     } else {
  707.     set i [IconList_Index $w anchor]
  708.     if {$i eq ""} {
  709.         return
  710.     }
  711.     incr i [expr {$amount*$data(itemsPerColumn)}]
  712.     }
  713.     IconList_Selection $w clear 0 end
  714.     IconList_Selection $w set $i
  715.     IconList_Selection $w anchor $i
  716.     IconList_See $w $i
  717. }
  718.  
  719. #----------------------------------------------------------------------
  720. #        Accelerator key bindings
  721. #----------------------------------------------------------------------
  722.  
  723. # ::tk::IconList_KeyPress --
  724. #
  725. #    Gets called when user enters an arbitrary key in the listbox.
  726. #
  727. proc ::tk::IconList_KeyPress {w key} {
  728.     variable ::tk::Priv
  729.  
  730.     append Priv(ILAccel,$w) $key
  731.     IconList_Goto $w $Priv(ILAccel,$w)
  732.     catch {
  733.     after cancel $Priv(ILAccel,$w,afterId)
  734.     }
  735.     set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]]
  736. }
  737.  
  738. proc ::tk::IconList_Goto {w text} {
  739.     upvar ::tk::$w data
  740.     upvar ::tk::$w:textList textList
  741.  
  742.     if {![info exists data(list)]} {
  743.     return
  744.     }
  745.  
  746.     if {$text eq "" || $data(numItems) == 0} {
  747.     return
  748.     }
  749.  
  750.     if {[llength [IconList_CurSelection $w]]} {
  751.     set start [IconList_Index $w anchor]
  752.     } else {
  753.     set start 0
  754.     }
  755.  
  756.     set theIndex -1
  757.     set less 0
  758.     set len [string length $text]
  759.     set len0 [expr {$len-1}]
  760.     set i $start
  761.  
  762.     # Search forward until we find a filename whose prefix is a
  763.     # case-insensitive match with $text
  764.     while {1} {
  765.     if {[string equal -nocase -length $len0 $textList($i) $text]} {
  766.         set theIndex $i
  767.         break
  768.     }
  769.     incr i
  770.     if {$i == $data(numItems)} {
  771.         set i 0
  772.     }
  773.     if {$i == $start} {
  774.         break
  775.     }
  776.     }
  777.  
  778.     if {$theIndex > -1} {
  779.     IconList_Selection $w clear 0 end
  780.     IconList_Selection $w set $theIndex
  781.     IconList_Selection $w anchor $theIndex
  782.     IconList_See $w $theIndex
  783.     }
  784. }
  785.  
  786. proc ::tk::IconList_Reset {w} {
  787.     variable ::tk::Priv
  788.  
  789.     unset -nocomplain Priv(ILAccel,$w)
  790. }
  791.  
  792. #----------------------------------------------------------------------
  793. #
  794. #              F I L E   D I A L O G
  795. #
  796. #----------------------------------------------------------------------
  797.  
  798. namespace eval ::tk::dialog {}
  799. namespace eval ::tk::dialog::file {
  800.     namespace import -force ::tk::msgcat::*
  801.     set ::tk::dialog::file::showHiddenBtn 0
  802.     set ::tk::dialog::file::showHiddenVar 1
  803. }
  804.  
  805. # ::tk::dialog::file:: --
  806. #
  807. #    Implements the TK file selection dialog. This dialog is used when
  808. #    the tk_strictMotif flag is set to false. This procedure shouldn't
  809. #    be called directly. Call tk_getOpenFile or tk_getSaveFile instead.
  810. #
  811. # Arguments:
  812. #    type        "open" or "save"
  813. #    args        Options parsed by the procedure.
  814. #
  815.  
  816. proc ::tk::dialog::file:: {type args} {
  817.     variable ::tk::Priv
  818.     set dataName __tk_filedialog
  819.     upvar ::tk::dialog::file::$dataName data
  820.  
  821.     Config $dataName $type $args
  822.  
  823.     if {$data(-parent) eq "."} {
  824.     set w .$dataName
  825.     } else {
  826.     set w $data(-parent).$dataName
  827.     }
  828.  
  829.     # (re)create the dialog box if necessary
  830.     #
  831.     if {![winfo exists $w]} {
  832.     Create $w TkFDialog
  833.     } elseif {[winfo class $w] ne "TkFDialog"} {
  834.     destroy $w
  835.     Create $w TkFDialog
  836.     } else {
  837.     set data(dirMenuBtn) $w.contents.f1.menu
  838.     set data(dirMenu) $w.contents.f1.menu.menu
  839.     set data(upBtn) $w.contents.f1.up
  840.     set data(icons) $w.contents.icons
  841.     set data(ent) $w.contents.f2.ent
  842.     set data(typeMenuLab) $w.contents.f2.lab2
  843.     set data(typeMenuBtn) $w.contents.f2.menu
  844.     set data(typeMenu) $data(typeMenuBtn).m
  845.     set data(okBtn) $w.contents.f2.ok
  846.     set data(cancelBtn) $w.contents.f2.cancel
  847.     set data(hiddenBtn) $w.contents.f2.hidden
  848.     SetSelectMode $w $data(-multiple)
  849.     }
  850.     if {$::tk::dialog::file::showHiddenBtn} {
  851.     $data(hiddenBtn) configure -state normal
  852.     grid $data(hiddenBtn)
  853.     } else {
  854.     $data(hiddenBtn) configure -state disabled
  855.     grid remove $data(hiddenBtn)
  856.     }
  857.  
  858.     # Make sure subseqent uses of this dialog are independent [Bug 845189]
  859.     unset -nocomplain data(extUsed)
  860.  
  861.     # Dialog boxes should be transient with respect to their parent,
  862.     # so that they will always stay on top of their parent window.  However,
  863.     # some window managers will create the window as withdrawn if the parent
  864.     # window is withdrawn or iconified.  Combined with the grab we put on the
  865.     # window, this can hang the entire application.  Therefore we only make
  866.     # the dialog transient if the parent is viewable.
  867.  
  868.     if {[winfo viewable [winfo toplevel $data(-parent)]]} {
  869.     wm transient $w $data(-parent)
  870.     }
  871.  
  872.     # Add traces on the selectPath variable
  873.     #
  874.  
  875.     trace add variable data(selectPath) write \
  876.         [list ::tk::dialog::file::SetPath $w]
  877.     $data(dirMenuBtn) configure \
  878.         -textvariable ::tk::dialog::file::${dataName}(selectPath)
  879.  
  880.     # Cleanup previous menu
  881.     #
  882.     $data(typeMenu) delete 0 end
  883.     $data(typeMenuBtn) configure -state normal -text ""
  884.  
  885.     # Initialize the file types menu
  886.     #
  887.     if {[llength $data(-filetypes)]} {
  888.     # Default type and name to first entry
  889.     set initialtype     [lindex $data(-filetypes) 0]
  890.     set initialTypeName [lindex $initialtype 0]
  891.     if {$data(-typevariable) ne ""} {
  892.         upvar #0 $data(-typevariable) typeVariable
  893.         if {[info exists typeVariable]} {
  894.         set initialTypeName $typeVariable
  895.         }
  896.     }
  897.     foreach type $data(-filetypes) {
  898.         set title  [lindex $type 0]
  899.         set filter [lindex $type 1]
  900.         $data(typeMenu) add command -label $title \
  901.         -command [list ::tk::dialog::file::SetFilter $w $type]
  902.         # string first avoids glob-pattern char issues
  903.         if {[string first ${initialTypeName} $title] == 0} {
  904.         set initialtype $type
  905.         }
  906.     }
  907.     SetFilter $w $initialtype
  908.     $data(typeMenuBtn) configure -state normal
  909.     $data(typeMenuLab) configure -state normal
  910.     } else {
  911.     set data(filter) "*"
  912.     $data(typeMenuBtn) configure -state disabled -takefocus 0
  913.     $data(typeMenuLab) configure -state disabled
  914.     }
  915.     UpdateWhenIdle $w
  916.  
  917.     # Withdraw the window, then update all the geometry information
  918.     # so we know how big it wants to be, then center the window in the
  919.     # display and de-iconify it.
  920.  
  921.     ::tk::PlaceWindow $w widget $data(-parent)
  922.     wm title $w $data(-title)
  923.  
  924.     # Set a grab and claim the focus too.
  925.  
  926.     ::tk::SetFocusGrab $w $data(ent)
  927.     $data(ent) delete 0 end
  928.     $data(ent) insert 0 $data(selectFile)
  929.     $data(ent) selection range 0 end
  930.     $data(ent) icursor end
  931.  
  932.     # Wait for the user to respond, then restore the focus and
  933.     # return the index of the selected button.  Restore the focus
  934.     # before deleting the window, since otherwise the window manager
  935.     # may take the focus away so we can't redirect it.  Finally,
  936.     # restore any grab that was in effect.
  937.  
  938.     vwait ::tk::Priv(selectFilePath)
  939.  
  940.     ::tk::RestoreFocusGrab $w $data(ent) withdraw
  941.  
  942.     # Cleanup traces on selectPath variable
  943.     #
  944.  
  945.     foreach trace [trace info variable data(selectPath)] {
  946.     trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  947.     }
  948.     $data(dirMenuBtn) configure -textvariable {}
  949.  
  950.     return $Priv(selectFilePath)
  951. }
  952.  
  953. # ::tk::dialog::file::Config --
  954. #
  955. #    Configures the TK filedialog according to the argument list
  956. #
  957. proc ::tk::dialog::file::Config {dataName type argList} {
  958.     upvar ::tk::dialog::file::$dataName data
  959.  
  960.     set data(type) $type
  961.  
  962.     # 0: Delete all variable that were set on data(selectPath) the
  963.     # last time the file dialog is used. The traces may cause troubles
  964.     # if the dialog is now used with a different -parent option.
  965.  
  966.     foreach trace [trace info variable data(selectPath)] {
  967.     trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1]
  968.     }
  969.  
  970.     # 1: the configuration specs
  971.     #
  972.     set specs {
  973.     {-defaultextension "" "" ""}
  974.     {-filetypes "" "" ""}
  975.     {-initialdir "" "" ""}
  976.     {-initialfile "" "" ""}
  977.     {-parent "" "" "."}
  978.     {-title "" "" ""}
  979.     {-typevariable "" "" ""}
  980.     }
  981.  
  982.     # The "-multiple" option is only available for the "open" file dialog.
  983.     #
  984.     if {$type eq "open"} {
  985.     lappend specs {-multiple "" "" "0"}
  986.     }
  987.  
  988.     # 2: default values depending on the type of the dialog
  989.     #
  990.     if {![info exists data(selectPath)]} {
  991.     # first time the dialog has been popped up
  992.     set data(selectPath) [pwd]
  993.     set data(selectFile) ""
  994.     }
  995.  
  996.     # 3: parse the arguments
  997.     #
  998.     tclParseConfigSpec ::tk::dialog::file::$dataName $specs "" $argList
  999.  
  1000.     if {$data(-title) eq ""} {
  1001.     if {$type eq "open"} {
  1002.         set data(-title) [mc "Open"]
  1003.     } else {
  1004.         set data(-title) [mc "Save As"]
  1005.     }
  1006.     }
  1007.  
  1008.     # 4: set the default directory and selection according to the -initial
  1009.     #    settings
  1010.     #
  1011.     if {$data(-initialdir) ne ""} {
  1012.     # Ensure that initialdir is an absolute path name.
  1013.     if {[file isdirectory $data(-initialdir)]} {
  1014.         set old [pwd]
  1015.         cd $data(-initialdir)
  1016.         set data(selectPath) [pwd]
  1017.         cd $old
  1018.     } else {
  1019.         set data(selectPath) [pwd]
  1020.     }
  1021.     }
  1022.     set data(selectFile) $data(-initialfile)
  1023.  
  1024.     # 5. Parse the -filetypes option
  1025.     #
  1026.     set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)]
  1027.  
  1028.     if {![winfo exists $data(-parent)]} {
  1029.     error "bad window path name \"$data(-parent)\""
  1030.     }
  1031.  
  1032.     # Set -multiple to a one or zero value (not other boolean types
  1033.     # like "yes") so we can use it in tests more easily.
  1034.     if {$type eq "save"} {
  1035.     set data(-multiple) 0
  1036.     } elseif {$data(-multiple)} {
  1037.     set data(-multiple) 1
  1038.     } else {
  1039.     set data(-multiple) 0
  1040.     }
  1041. }
  1042.  
  1043. proc ::tk::dialog::file::Create {w class} {
  1044.     set dataName [lindex [split $w .] end]
  1045.     upvar ::tk::dialog::file::$dataName data
  1046.     variable ::tk::Priv
  1047.     global tk_library
  1048.  
  1049.     toplevel $w -class $class
  1050.     pack [ttk::frame $w.contents] -expand 1 -fill both
  1051.     #set w $w.contents
  1052.  
  1053.     # f1: the frame with the directory option menu
  1054.     #
  1055.     set f1 [ttk::frame $w.contents.f1]
  1056.     bind [::tk::AmpWidget ttk::label $f1.lab -text [mc "&Directory:"]] \
  1057.         <<AltUnderlined>> [list focus $f1.menu]
  1058.  
  1059.     set data(dirMenuBtn) $f1.menu
  1060.     if {![info exists data(selectPath)]} {
  1061.     set data(selectPath) ""
  1062.     }
  1063.     set data(dirMenu) $f1.menu.menu
  1064.     ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \
  1065.         -textvariable [format %s(selectPath) ::tk::dialog::file::$dataName]
  1066.     [menu $data(dirMenu) -tearoff 0] add radiobutton -label "" -variable \
  1067.         [format %s(selectPath) ::tk::dialog::file::$dataName]
  1068.     set data(upBtn) [ttk::button $f1.up]
  1069.     if {![info exists Priv(updirImage)]} {
  1070.     set Priv(updirImage) [image create bitmap -data {
  1071. #define updir_width 28
  1072. #define updir_height 16
  1073. static char updir_bits[] = {
  1074.    0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
  1075.    0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
  1076.    0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
  1077.    0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
  1078.    0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
  1079.    0xf0, 0xff, 0xff, 0x01};}]
  1080.     }
  1081.     $data(upBtn) configure -image $Priv(updirImage)
  1082.  
  1083.     $f1.menu configure -takefocus 1;# -highlightthickness 2
  1084.  
  1085.     pack $data(upBtn) -side right -padx 4 -fill both
  1086.     pack $f1.lab -side left -padx 4 -fill both
  1087.     pack $f1.menu -expand yes -fill both -padx 4
  1088.  
  1089.     # data(icons): the IconList that list the files and directories.
  1090.     #
  1091.     if {$class eq "TkFDialog"} {
  1092.     if { $data(-multiple) } {
  1093.         set fNameCaption [mc "File &names:"]
  1094.     } else {
  1095.         set fNameCaption [mc "File &name:"]
  1096.     }
  1097.     set fTypeCaption [mc "Files of &type:"]
  1098.     set iconListCommand [list ::tk::dialog::file::OkCmd $w]
  1099.     } else {
  1100.     set fNameCaption [mc "&Selection:"]
  1101.     set iconListCommand [list ::tk::dialog::file::chooseDir::DblClick $w]
  1102.     }
  1103.     set data(icons) [::tk::IconList $w.contents.icons \
  1104.         -command $iconListCommand -multiple $data(-multiple)]
  1105.     bind $data(icons) <<ListboxSelect>> \
  1106.         [list ::tk::dialog::file::ListBrowse $w]
  1107.  
  1108.     # f2: the frame with the OK button, cancel button, "file name" field
  1109.     #     and file types field.
  1110.     #
  1111.     set f2 [ttk::frame $w.contents.f2]
  1112.     bind [::tk::AmpWidget ttk::label $f2.lab -text $fNameCaption -anchor e]\
  1113.         <<AltUnderlined>> [list focus $f2.ent]
  1114.     # -pady 0
  1115.     set data(ent) [ttk::entry $f2.ent]
  1116.  
  1117.     # The font to use for the icons. The default Canvas font on Unix
  1118.     # is just deviant.
  1119.     set ::tk::$w.contents.icons(font) [$data(ent) cget -font]
  1120.  
  1121.     # Make the file types bits only if this is a File Dialog
  1122.     if {$class eq "TkFDialog"} {
  1123.     set data(typeMenuLab) [::tk::AmpWidget ttk::label $f2.lab2 \
  1124.         -text $fTypeCaption -anchor e]
  1125.     # -pady [$f2.lab cget -pady]
  1126.     set data(typeMenuBtn) [ttk::menubutton $f2.menu \
  1127.         -menu $f2.menu.m]
  1128.     # -indicatoron 1
  1129.     set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
  1130.     # $data(typeMenuBtn) configure -takefocus 1 -relief raised -anchor w
  1131.     bind $data(typeMenuLab) <<AltUnderlined>> [list \
  1132.         focus $data(typeMenuBtn)]
  1133.     }
  1134.  
  1135.     # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn
  1136.     # is true.  Create it disabled so the binding doesn't trigger if it
  1137.     # isn't shown.
  1138.     if {$class eq "TkFDialog"} {
  1139.     set text [mc "Show &Hidden Files and Directories"]
  1140.     } else {
  1141.     set text [mc "Show &Hidden Directories"]
  1142.     }
  1143.     set data(hiddenBtn) [::tk::AmpWidget ttk::checkbutton $f2.hidden \
  1144.         -text $text -state disabled \
  1145.         -variable ::tk::dialog::file::showHiddenVar \
  1146.         -command [list ::tk::dialog::file::UpdateWhenIdle $w]]
  1147. # -anchor w -padx 3
  1148.  
  1149.     # the okBtn is created after the typeMenu so that the keyboard traversal
  1150.     # is in the right order, and add binding so that we find out when the
  1151.     # dialog is destroyed by the user (added here instead of to the overall
  1152.     # window so no confusion about how much <Destroy> gets called; exactly
  1153.     # once will do). [Bug 987169]
  1154.  
  1155.     set data(okBtn)     [::tk::AmpWidget ttk::button $f2.ok \
  1156.         -text [mc "&OK"]     -default active];# -pady 3]
  1157.     bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w]
  1158.     set data(cancelBtn) [::tk::AmpWidget ttk::button $f2.cancel \
  1159.         -text [mc "&Cancel"] -default normal];# -pady 3]
  1160.  
  1161.     # grid the widgets in f2
  1162.     #
  1163.     grid $f2.lab $f2.ent $data(okBtn) -padx 4 -pady 3 -sticky ew
  1164.     grid configure $f2.ent -padx 2
  1165.     if {$class eq "TkFDialog"} {
  1166.     grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
  1167.         -padx 4 -sticky ew
  1168.     grid configure $data(typeMenuBtn) -padx 0
  1169.     grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew
  1170.     } else {
  1171.     grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew
  1172.     }
  1173.     grid columnconfigure $f2 1 -weight 1
  1174.  
  1175.     # Pack all the frames together. We are done with widget construction.
  1176.     #
  1177.     pack $f1 -side top -fill x -pady 4
  1178.     pack $f2 -side bottom -pady 4 -fill x
  1179.     pack $data(icons) -expand yes -fill both -padx 4 -pady 1
  1180.  
  1181.     # Set up the event handlers that are common to Directory and File Dialogs
  1182.     #
  1183.  
  1184.     wm protocol $w WM_DELETE_WINDOW [list ::tk::dialog::file::CancelCmd $w]
  1185.     $data(upBtn)     configure -command [list ::tk::dialog::file::UpDirCmd $w]
  1186.     $data(cancelBtn) configure -command [list ::tk::dialog::file::CancelCmd $w]
  1187.     bind $w <KeyPress-Escape> [list $data(cancelBtn) invoke]
  1188.     bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]
  1189.  
  1190.     # Set up event handlers specific to File or Directory Dialogs
  1191.     #
  1192.     if {$class eq "TkFDialog"} {
  1193.     bind $data(ent) <Return> [list ::tk::dialog::file::ActivateEnt $w]
  1194.     $data(okBtn)     configure -command [list ::tk::dialog::file::OkCmd $w]
  1195.     bind $w <Alt-t> [format {
  1196.         if {[%s cget -state] eq "normal"} {
  1197.         focus %s
  1198.         }
  1199.     } $data(typeMenuBtn) $data(typeMenuBtn)]
  1200.     } else {
  1201.     set okCmd [list ::tk::dialog::file::chooseDir::OkCmd $w]
  1202.     bind $data(ent) <Return> $okCmd
  1203.     $data(okBtn) configure -command $okCmd
  1204.     bind $w <Alt-s> [list focus $data(ent)]
  1205.     bind $w <Alt-o> [list $data(okBtn) invoke]
  1206.     }
  1207.     bind $w <Alt-h> [list $data(hiddenBtn) invoke]
  1208.     bind $data(ent) <Tab> [list ::tk::dialog::file::CompleteEnt $w]
  1209.  
  1210.     # Build the focus group for all the entries
  1211.     #
  1212.     ::tk::FocusGroup_Create $w
  1213.     ::tk::FocusGroup_BindIn $w  $data(ent) [list \
  1214.         ::tk::dialog::file::EntFocusIn $w]
  1215.     ::tk::FocusGroup_BindOut $w $data(ent) [list \
  1216.         ::tk::dialog::file::EntFocusOut $w]
  1217. }
  1218.  
  1219. # ::tk::dialog::file::SetSelectMode --
  1220. #
  1221. #    Set the select mode of the dialog to single select or multi-select.
  1222. #
  1223. # Arguments:
  1224. #    w        The dialog path.
  1225. #    multi        1 if the dialog is multi-select; 0 otherwise.
  1226. #
  1227. # Results:
  1228. #    None.
  1229.  
  1230. proc ::tk::dialog::file::SetSelectMode {w multi} {
  1231.     set dataName __tk_filedialog
  1232.     upvar ::tk::dialog::file::$dataName data
  1233.     if { $multi } {
  1234.     set fNameCaption [mc "File &names:"]
  1235.     } else {
  1236.     set fNameCaption [mc "File &name:"]
  1237.     }
  1238.     set iconListCommand [list ::tk::dialog::file::OkCmd $w]
  1239.     ::tk::SetAmpText $w.contents.f2.lab $fNameCaption
  1240.     ::tk::IconList_Config $data(icons) \
  1241.         [list -multiple $multi -command $iconListCommand]
  1242.     return
  1243. }
  1244.  
  1245. # ::tk::dialog::file::UpdateWhenIdle --
  1246. #
  1247. #    Creates an idle event handler which updates the dialog in idle
  1248. #    time. This is important because loading the directory may take a long
  1249. #    time and we don't want to load the same directory for multiple times
  1250. #    due to multiple concurrent events.
  1251. #
  1252. proc ::tk::dialog::file::UpdateWhenIdle {w} {
  1253.     upvar ::tk::dialog::file::[winfo name $w] data
  1254.  
  1255.     if {[info exists data(updateId)]} {
  1256.     return
  1257.     } else {
  1258.     set data(updateId) [after idle [list ::tk::dialog::file::Update $w]]
  1259.     }
  1260. }
  1261.  
  1262. # ::tk::dialog::file::Update --
  1263. #
  1264. #    Loads the files and directories into the IconList widget. Also
  1265. #    sets up the directory option menu for quick access to parent
  1266. #    directories.
  1267. #
  1268. proc ::tk::dialog::file::Update {w} {
  1269.  
  1270.     # This proc may be called within an idle handler. Make sure that the
  1271.     # window has not been destroyed before this proc is called
  1272.     if {![winfo exists $w]} {
  1273.     return
  1274.     }
  1275.     set class [winfo class $w]
  1276.     if {($class ne "TkFDialog") && ($class ne "TkChooseDir")} {
  1277.     return
  1278.     }
  1279.  
  1280.     set dataName [winfo name $w]
  1281.     upvar ::tk::dialog::file::$dataName data
  1282.     variable ::tk::Priv
  1283.     global tk_library
  1284.     unset -nocomplain data(updateId)
  1285.  
  1286.     if {![info exists Priv(folderImage)]} {
  1287.     set Priv(folderImage) [image create photo -data {
  1288. R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB
  1289. QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}]
  1290.     set Priv(fileImage)   [image create photo -data {
  1291. R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO
  1292. rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}]
  1293.     }
  1294.     set folder $Priv(folderImage)
  1295.     set file   $Priv(fileImage)
  1296.  
  1297.     set appPWD [pwd]
  1298.     if {[catch {
  1299.     cd $data(selectPath)
  1300.     }]} {
  1301.     # We cannot change directory to $data(selectPath). $data(selectPath)
  1302.     # should have been checked before ::tk::dialog::file::Update is called, so
  1303.     # we normally won't come to here. Anyways, give an error and abort
  1304.     # action.
  1305.     tk_messageBox -type ok -parent $w -icon warning -message \
  1306.         [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)]
  1307.     cd $appPWD
  1308.     return
  1309.     }
  1310.  
  1311.     # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
  1312.     # so the user may still click and cause havoc ...
  1313.     #
  1314.     set entCursor [$data(ent) cget -cursor]
  1315.     set dlgCursor [$w         cget -cursor]
  1316.     $data(ent) configure -cursor watch
  1317.     $w         configure -cursor watch
  1318.     update idletasks
  1319.  
  1320.     ::tk::IconList_DeleteAll $data(icons)
  1321.  
  1322.     set showHidden $::tk::dialog::file::showHiddenVar
  1323.  
  1324.     # Make the dir list
  1325.     # Using -directory [pwd] is better in some VFS cases.
  1326.     set cmd [list glob -tails -directory [pwd] -type d -nocomplain *]
  1327.     if {$showHidden} { lappend cmd .* }
  1328.     set dirs [lsort -dictionary -unique [eval $cmd]]
  1329.     set dirList {}
  1330.     foreach d $dirs {
  1331.     if {$d eq "." || $d eq ".."} {
  1332.         continue
  1333.     }
  1334.     lappend dirList $d
  1335.     }
  1336.     ::tk::IconList_Add $data(icons) $folder $dirList
  1337.  
  1338.     if {$class eq "TkFDialog"} {
  1339.     # Make the file list if this is a File Dialog, selecting all
  1340.     # but 'd'irectory type files.
  1341.     #
  1342.     set cmd [list glob -tails -directory [pwd] \
  1343.         -type {f b c l p s} -nocomplain]
  1344.     if {$data(filter) eq "*"} {
  1345.         lappend cmd *
  1346.         if {$showHidden} {
  1347.         lappend cmd .*
  1348.         }
  1349.     } else {
  1350.         eval [list lappend cmd] $data(filter)
  1351.     }
  1352.     set fileList [lsort -dictionary -unique [eval $cmd]]
  1353.     ::tk::IconList_Add $data(icons) $file $fileList
  1354.     }
  1355.  
  1356.     ::tk::IconList_Arrange $data(icons)
  1357.  
  1358.     # Update the Directory: option menu
  1359.     #
  1360.     set list ""
  1361.     set dir ""
  1362.     foreach subdir [file split $data(selectPath)] {
  1363.     set dir [file join $dir $subdir]
  1364.     lappend list $dir
  1365.     }
  1366.  
  1367.     $data(dirMenu) delete 0 end
  1368.     set var [format %s(selectPath) ::tk::dialog::file::$dataName]
  1369.     foreach path $list {
  1370.     $data(dirMenu) add command -label $path -command [list set $var $path]
  1371.     }
  1372.  
  1373.     # Restore the PWD to the application's PWD
  1374.     #
  1375.     cd $appPWD
  1376.  
  1377.     if {$class eq "TkFDialog"} {
  1378.     # Restore the Open/Save Button if this is a File Dialog
  1379.     #
  1380.     if {$data(type) eq "open"} {
  1381.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1382.     } else {
  1383.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1384.     }
  1385.     }
  1386.  
  1387.     # turn off the busy cursor.
  1388.     #
  1389.     $data(ent) configure -cursor $entCursor
  1390.     $w         configure -cursor $dlgCursor
  1391. }
  1392.  
  1393. # ::tk::dialog::file::SetPathSilently --
  1394. #
  1395. #     Sets data(selectPath) without invoking the trace procedure
  1396. #
  1397. proc ::tk::dialog::file::SetPathSilently {w path} {
  1398.     upvar ::tk::dialog::file::[winfo name $w] data
  1399.  
  1400.     trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  1401.     set data(selectPath) $path
  1402.     trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w]
  1403. }
  1404.  
  1405.  
  1406. # This proc gets called whenever data(selectPath) is set
  1407. #
  1408. proc ::tk::dialog::file::SetPath {w name1 name2 op} {
  1409.     if {[winfo exists $w]} {
  1410.     upvar ::tk::dialog::file::[winfo name $w] data
  1411.     UpdateWhenIdle $w
  1412.     # On directory dialogs, we keep the entry in sync with the currentdir.
  1413.     if {[winfo class $w] eq "TkChooseDir"} {
  1414.         $data(ent) delete 0 end
  1415.         $data(ent) insert end $data(selectPath)
  1416.     }
  1417.     }
  1418. }
  1419.  
  1420. # This proc gets called whenever data(filter) is set
  1421. #
  1422. proc ::tk::dialog::file::SetFilter {w type} {
  1423.     upvar ::tk::dialog::file::[winfo name $w] data
  1424.     upvar ::tk::$data(icons) icons
  1425.  
  1426.     set data(filterType) $type
  1427.     set data(filter) [lindex $type 1]
  1428.     $data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1
  1429.  
  1430.     # If we aren't using a default extension, use the one suppled
  1431.     # by the filter.
  1432.     if {![info exists data(extUsed)]} {
  1433.     if {[string length $data(-defaultextension)]} {
  1434.         set data(extUsed) 1
  1435.     } else {
  1436.         set data(extUsed) 0
  1437.     }
  1438.     }
  1439.  
  1440.     if {!$data(extUsed)} {
  1441.     # Get the first extension in the list that matches {^\*\.\w+$}
  1442.     # and remove all * from the filter.
  1443.     set index [lsearch -regexp $data(filter) {^\*\.\w+$}]
  1444.     if {$index >= 0} {
  1445.         set data(-defaultextension) \
  1446.             [string trimleft [lindex $data(filter) $index] "*"]
  1447.     } else {
  1448.         # Couldn't find anything!  Reset to a safe default...
  1449.         set data(-defaultextension) ""
  1450.     }
  1451.     }
  1452.  
  1453.     $icons(sbar) set 0.0 0.0
  1454.  
  1455.     UpdateWhenIdle $w
  1456. }
  1457.  
  1458. # tk::dialog::file::ResolveFile --
  1459. #
  1460. #    Interpret the user's text input in a file selection dialog.
  1461. #    Performs:
  1462. #
  1463. #    (1) ~ substitution
  1464. #    (2) resolve all instances of . and ..
  1465. #    (3) check for non-existent files/directories
  1466. #    (4) check for chdir permissions
  1467. #    (5) conversion of environment variable references to their
  1468. #        contents (once only)
  1469. #
  1470. # Arguments:
  1471. #    context:  the current directory you are in
  1472. #    text:      the text entered by the user
  1473. #    defaultext: the default extension to add to files with no extension
  1474. #    expandEnv: whether to expand environment variables (yes by default)
  1475. #
  1476. # Return vaue:
  1477. #    [list $flag $directory $file]
  1478. #
  1479. #     flag = OK    : valid input
  1480. #          = PATTERN    : valid directory/pattern
  1481. #          = PATH    : the directory does not exist
  1482. #          = FILE    : the directory exists by the file doesn't
  1483. #              exist
  1484. #          = CHDIR    : Cannot change to the directory
  1485. #          = ERROR    : Invalid entry
  1486. #
  1487. #     directory      : valid only if flag = OK or PATTERN or FILE
  1488. #     file           : valid only if flag = OK or PATTERN
  1489. #
  1490. #    directory may not be the same as context, because text may contain
  1491. #    a subdirectory name
  1492. #
  1493. proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} {
  1494.     set appPWD [pwd]
  1495.  
  1496.     set path [JoinFile $context $text]
  1497.  
  1498.     # If the file has no extension, append the default.  Be careful not
  1499.     # to do this for directories, otherwise typing a dirname in the box
  1500.     # will give back "dirname.extension" instead of trying to change dir.
  1501.     if {
  1502.     ![file isdirectory $path] && ([file ext $path] eq "") &&
  1503.     ![string match {$*} [file tail $path]]
  1504.     } then {
  1505.     set path "$path$defaultext"
  1506.     }
  1507.  
  1508.     if {[catch {file exists $path}]} {
  1509.     # This "if" block can be safely removed if the following code
  1510.     # stop generating errors.
  1511.     #
  1512.     #    file exists ~nonsuchuser
  1513.     #
  1514.     return [list ERROR $path ""]
  1515.     }
  1516.  
  1517.     if {[file exists $path]} {
  1518.     if {[file isdirectory $path]} {
  1519.         if {[catch {cd $path}]} {
  1520.         return [list CHDIR $path ""]
  1521.         }
  1522.         set directory [pwd]
  1523.         set file ""
  1524.         set flag OK
  1525.         cd $appPWD
  1526.     } else {
  1527.         if {[catch {cd [file dirname $path]}]} {
  1528.         return [list CHDIR [file dirname $path] ""]
  1529.         }
  1530.         set directory [pwd]
  1531.         set file [file tail $path]
  1532.         set flag OK
  1533.         cd $appPWD
  1534.     }
  1535.     } else {
  1536.     set dirname [file dirname $path]
  1537.     if {[file exists $dirname]} {
  1538.         if {[catch {cd $dirname}]} {
  1539.         return [list CHDIR $dirname ""]
  1540.         }
  1541.         set directory [pwd]
  1542.         cd $appPWD
  1543.         set file [file tail $path]
  1544.         # It's nothing else, so check to see if it is an env-reference
  1545.         if {$expandEnv && [string match {$*} $file]} {
  1546.         set var [string range $file 1 end]
  1547.         if {[info exist ::env($var)]} {
  1548.             return [ResolveFile $context $::env($var) $defaultext 0]
  1549.         }
  1550.         }
  1551.         if {[regexp {[*?]} $file]} {
  1552.         set flag PATTERN
  1553.         } else {
  1554.         set flag FILE
  1555.         }
  1556.     } else {
  1557.         set directory $dirname
  1558.         set file [file tail $path]
  1559.         set flag PATH
  1560.         # It's nothing else, so check to see if it is an env-reference
  1561.         if {$expandEnv && [string match {$*} $file]} {
  1562.         set var [string range $file 1 end]
  1563.         if {[info exist ::env($var)]} {
  1564.             return [ResolveFile $context $::env($var) $defaultext 0]
  1565.         }
  1566.         }
  1567.     }
  1568.     }
  1569.  
  1570.     return [list $flag $directory $file]
  1571. }
  1572.  
  1573.  
  1574. # Gets called when the entry box gets keyboard focus. We clear the selection
  1575. # from the icon list . This way the user can be certain that the input in the
  1576. # entry box is the selection.
  1577. #
  1578. proc ::tk::dialog::file::EntFocusIn {w} {
  1579.     upvar ::tk::dialog::file::[winfo name $w] data
  1580.  
  1581.     if {[$data(ent) get] ne ""} {
  1582.     $data(ent) selection range 0 end
  1583.     $data(ent) icursor end
  1584.     } else {
  1585.     $data(ent) selection clear
  1586.     }
  1587.  
  1588.     if {[winfo class $w] eq "TkFDialog"} {
  1589.     # If this is a File Dialog, make sure the buttons are labeled right.
  1590.     if {$data(type) eq "open"} {
  1591.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1592.     } else {
  1593.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1594.     }
  1595.     }
  1596. }
  1597.  
  1598. proc ::tk::dialog::file::EntFocusOut {w} {
  1599.     upvar ::tk::dialog::file::[winfo name $w] data
  1600.  
  1601.     $data(ent) selection clear
  1602. }
  1603.  
  1604.  
  1605. # Gets called when user presses Return in the "File name" entry.
  1606. #
  1607. proc ::tk::dialog::file::ActivateEnt {w} {
  1608.     upvar ::tk::dialog::file::[winfo name $w] data
  1609.  
  1610.     set text [$data(ent) get]
  1611.     if {$data(-multiple)} {
  1612.     foreach t $text {
  1613.         VerifyFileName $w $t
  1614.     }
  1615.     } else {
  1616.     VerifyFileName $w $text
  1617.     }
  1618. }
  1619.  
  1620. # Verification procedure
  1621. #
  1622. proc ::tk::dialog::file::VerifyFileName {w filename} {
  1623.     upvar ::tk::dialog::file::[winfo name $w] data
  1624.  
  1625.     set list [ResolveFile $data(selectPath) $filename $data(-defaultextension)]
  1626.     foreach {flag path file} $list {
  1627.     break
  1628.     }
  1629.  
  1630.     switch -- $flag {
  1631.     OK {
  1632.         if {$file eq ""} {
  1633.         # user has entered an existing (sub)directory
  1634.         set data(selectPath) $path
  1635.         $data(ent) delete 0 end
  1636.         } else {
  1637.         SetPathSilently $w $path
  1638.         if {$data(-multiple)} {
  1639.             lappend data(selectFile) $file
  1640.         } else {
  1641.             set data(selectFile) $file
  1642.         }
  1643.         Done $w
  1644.         }
  1645.     }
  1646.     PATTERN {
  1647.         set data(selectPath) $path
  1648.         set data(filter) $file
  1649.     }
  1650.     FILE {
  1651.         if {$data(type) eq "open"} {
  1652.         tk_messageBox -icon warning -type ok -parent $w \
  1653.             -message [mc "File \"%1\$s\"  does not exist." \
  1654.             [file join $path $file]]
  1655.         $data(ent) selection range 0 end
  1656.         $data(ent) icursor end
  1657.         } else {
  1658.         SetPathSilently $w $path
  1659.         if {$data(-multiple)} {
  1660.             lappend data(selectFile) $file
  1661.         } else {
  1662.             set data(selectFile) $file
  1663.         }
  1664.         Done $w
  1665.         }
  1666.     }
  1667.     PATH {
  1668.         tk_messageBox -icon warning -type ok -parent $w \
  1669.             -message [mc "Directory \"%1\$s\" does not exist." $path]
  1670.         $data(ent) selection range 0 end
  1671.         $data(ent) icursor end
  1672.     }
  1673.     CHDIR {
  1674.         tk_messageBox -type ok -parent $w -icon warning -message  \
  1675.         [mc "Cannot change to the directory\
  1676.                      \"%1\$s\".\nPermission denied." $path]
  1677.         $data(ent) selection range 0 end
  1678.         $data(ent) icursor end
  1679.     }
  1680.     ERROR {
  1681.         tk_messageBox -type ok -parent $w -icon warning -message \
  1682.             [mc "Invalid file name \"%1\$s\"." $path]
  1683.         $data(ent) selection range 0 end
  1684.         $data(ent) icursor end
  1685.     }
  1686.     }
  1687. }
  1688.  
  1689. # Gets called when user presses the Alt-s or Alt-o keys.
  1690. #
  1691. proc ::tk::dialog::file::InvokeBtn {w key} {
  1692.     upvar ::tk::dialog::file::[winfo name $w] data
  1693.  
  1694.     if {[$data(okBtn) cget -text] eq $key} {
  1695.     $data(okBtn) invoke
  1696.     }
  1697. }
  1698.  
  1699. # Gets called when user presses the "parent directory" button
  1700. #
  1701. proc ::tk::dialog::file::UpDirCmd {w} {
  1702.     upvar ::tk::dialog::file::[winfo name $w] data
  1703.  
  1704.     if {$data(selectPath) ne "/"} {
  1705.     set data(selectPath) [file dirname $data(selectPath)]
  1706.     }
  1707. }
  1708.  
  1709. # Join a file name to a path name. The "file join" command will break
  1710. # if the filename begins with ~
  1711. #
  1712. proc ::tk::dialog::file::JoinFile {path file} {
  1713.     if {[string match {~*} $file] && [file exists $path/$file]} {
  1714.     return [file join $path ./$file]
  1715.     } else {
  1716.     return [file join $path $file]
  1717.     }
  1718. }
  1719.  
  1720. # Gets called when user presses the "OK" button
  1721. #
  1722. proc ::tk::dialog::file::OkCmd {w} {
  1723.     upvar ::tk::dialog::file::[winfo name $w] data
  1724.  
  1725.     set filenames {}
  1726.     foreach item [::tk::IconList_CurSelection $data(icons)] {
  1727.     lappend filenames [::tk::IconList_Get $data(icons) $item]
  1728.     }
  1729.  
  1730.     if {([llength $filenames] && !$data(-multiple)) || \
  1731.         ($data(-multiple) && ([llength $filenames] == 1))} {
  1732.     set filename [lindex $filenames 0]
  1733.     set file [JoinFile $data(selectPath) $filename]
  1734.     if {[file isdirectory $file]} {
  1735.         ListInvoke $w [list $filename]
  1736.         return
  1737.     }
  1738.     }
  1739.  
  1740.     ActivateEnt $w
  1741. }
  1742.  
  1743. # Gets called when user presses the "Cancel" button
  1744. #
  1745. proc ::tk::dialog::file::CancelCmd {w} {
  1746.     upvar ::tk::dialog::file::[winfo name $w] data
  1747.     variable ::tk::Priv
  1748.  
  1749.     bind $data(okBtn) <Destroy> {}
  1750.     set Priv(selectFilePath) ""
  1751. }
  1752.  
  1753. # Gets called when user destroys the dialog directly [Bug 987169]
  1754. #
  1755. proc ::tk::dialog::file::Destroyed {w} {
  1756.     upvar ::tk::dialog::file::[winfo name $w] data
  1757.     variable ::tk::Priv
  1758.  
  1759.     set Priv(selectFilePath) ""
  1760. }
  1761.  
  1762. # Gets called when user browses the IconList widget (dragging mouse, arrow
  1763. # keys, etc)
  1764. #
  1765. proc ::tk::dialog::file::ListBrowse {w} {
  1766.     upvar ::tk::dialog::file::[winfo name $w] data
  1767.  
  1768.     set text {}
  1769.     foreach item [::tk::IconList_CurSelection $data(icons)] {
  1770.     lappend text [::tk::IconList_Get $data(icons) $item]
  1771.     }
  1772.     if {[llength $text] == 0} {
  1773.     return
  1774.     }
  1775.     if {$data(-multiple)} {
  1776.     set newtext {}
  1777.     foreach file $text {
  1778.         set fullfile [JoinFile $data(selectPath) $file]
  1779.         if { ![file isdirectory $fullfile] } {
  1780.         lappend newtext $file
  1781.         }
  1782.     }
  1783.     set text $newtext
  1784.     set isDir 0
  1785.     } else {
  1786.     set text [lindex $text 0]
  1787.     set file [JoinFile $data(selectPath) $text]
  1788.     set isDir [file isdirectory $file]
  1789.     }
  1790.     if {!$isDir} {
  1791.     $data(ent) delete 0 end
  1792.     $data(ent) insert 0 $text
  1793.  
  1794.     if {[winfo class $w] eq "TkFDialog"} {
  1795.         if {$data(type) eq "open"} {
  1796.         ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1797.         } else {
  1798.         ::tk::SetAmpText $data(okBtn) [mc "&Save"]
  1799.         }
  1800.     }
  1801.     } elseif {[winfo class $w] eq "TkFDialog"} {
  1802.     ::tk::SetAmpText $data(okBtn) [mc "&Open"]
  1803.     }
  1804. }
  1805.  
  1806. # Gets called when user invokes the IconList widget (double-click,
  1807. # Return key, etc)
  1808. #
  1809. proc ::tk::dialog::file::ListInvoke {w filenames} {
  1810.     upvar ::tk::dialog::file::[winfo name $w] data
  1811.  
  1812.     if {[llength $filenames] == 0} {
  1813.     return
  1814.     }
  1815.  
  1816.     set file [JoinFile $data(selectPath) [lindex $filenames 0]]
  1817.  
  1818.     set class [winfo class $w]
  1819.     if {$class eq "TkChooseDir" || [file isdirectory $file]} {
  1820.     set appPWD [pwd]
  1821.     if {[catch {cd $file}]} {
  1822.         tk_messageBox -type ok -parent $w -message -icon warning \
  1823.             [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $file]
  1824.     } else {
  1825.         cd $appPWD
  1826.         set data(selectPath) $file
  1827.     }
  1828.     } else {
  1829.     if {$data(-multiple)} {
  1830.         set data(selectFile) $filenames
  1831.     } else {
  1832.         set data(selectFile) $file
  1833.     }
  1834.     Done $w
  1835.     }
  1836. }
  1837.  
  1838. # ::tk::dialog::file::Done --
  1839. #
  1840. #    Gets called when user has input a valid filename.  Pops up a
  1841. #    dialog box to confirm selection when necessary. Sets the
  1842. #    tk::Priv(selectFilePath) variable, which will break the "vwait"
  1843. #    loop in ::tk::dialog::file:: and return the selected filename to the
  1844. #    script that calls tk_getOpenFile or tk_getSaveFile
  1845. #
  1846. proc ::tk::dialog::file::Done {w {selectFilePath ""}} {
  1847.     upvar ::tk::dialog::file::[winfo name $w] data
  1848.     variable ::tk::Priv
  1849.  
  1850.     if {$selectFilePath eq ""} {
  1851.     if {$data(-multiple)} {
  1852.         set selectFilePath {}
  1853.         foreach f $data(selectFile) {
  1854.         lappend selectFilePath [JoinFile $data(selectPath) $f]
  1855.         }
  1856.     } else {
  1857.         set selectFilePath [JoinFile $data(selectPath) $data(selectFile)]
  1858.     }
  1859.  
  1860.     set Priv(selectFile) $data(selectFile)
  1861.     set Priv(selectPath) $data(selectPath)
  1862.  
  1863.     if {($data(type) eq "save") && [file exists $selectFilePath]} {
  1864.         set reply [tk_messageBox -icon warning -type yesno -parent $w \
  1865.             -message [mc "File \"%1\$s\" already exists.\nDo you want\
  1866.             to overwrite it?" $selectFilePath]]
  1867.         if {$reply eq "no"} {
  1868.         return
  1869.         }
  1870.     }
  1871.     if {[info exists data(-typevariable)] && $data(-typevariable) ne ""
  1872.         && [info exists data(-filetypes)] && [llength $data(-filetypes)]
  1873.         && [info exists data(filterType)] && $data(filterType) ne ""} {
  1874.         upvar #0 $data(-typevariable) typeVariable
  1875.         set typeVariable [lindex $data(filterType) 0]
  1876.     }
  1877.     }
  1878.     bind $data(okBtn) <Destroy> {}
  1879.     set Priv(selectFilePath) $selectFilePath
  1880. }
  1881.  
  1882. proc ::tk::dialog::file::CompleteEnt {w} {
  1883.     upvar ::tk::dialog::file::[winfo name $w] data
  1884.     set f [$data(ent) get]
  1885.     if {$data(-multiple)} {
  1886.     if {[catch {llength $f} len] || $len != 1} {
  1887.         return -code break
  1888.     }
  1889.     set f [lindex $f 0]
  1890.     }
  1891.  
  1892.     # Get list of matching filenames and dirnames
  1893.     set globF [list glob -tails -directory $data(selectPath) \
  1894.         -type {f b c l p s} -nocomplain]
  1895.     set globD [list glob -tails -directory $data(selectPath) -type d \
  1896.                -nocomplain *]
  1897.     if {$data(filter) eq "*"} {
  1898.     lappend globF *
  1899.     if {$::tk::dialog::file::showHiddenVar} {
  1900.         lappend globF .*
  1901.         lappend globD .*
  1902.     }
  1903.     if {[winfo class $w] eq "TkFDialog"} {
  1904.         set files [lsort -dictionary -unique [{*}$globF]]
  1905.     } else {
  1906.         set files {}
  1907.     }
  1908.     set dirs [lsort -dictionary -unique [{*}$globD]]
  1909.     } else {
  1910.     if {$::tk::dialog::file::showHiddenVar} {
  1911.         lappend globD .*
  1912.     }
  1913.     if {[winfo class $w] eq "TkFDialog"} {
  1914.         set files [lsort -dictionary -unique [{*}$globF {*}$data(filter)]]
  1915.     } else {
  1916.         set files {}
  1917.     }
  1918.     set dirs [lsort -dictionary -unique [{*}$globD]]
  1919.     }
  1920.     # Filter specials
  1921.     set dirs [lsearch -all -not -exact -inline $dirs .]
  1922.     set dirs [lsearch -all -not -exact -inline $dirs ..]
  1923.     set dirs2 {}
  1924.     foreach d $dirs {lappend dirs2 $d/}
  1925.  
  1926.     set targets [concat \
  1927.         [lsearch -glob -all -inline $files $f*] \
  1928.         [lsearch -glob -all -inline $dirs2 $f*]]
  1929.  
  1930.     if {[llength $targets] == 1} {
  1931.     # We have a winner!
  1932.     set f [lindex $targets 0]
  1933.     } elseif {$f in $targets || [llength $targets] == 0} {
  1934.     if {[string length $f] > 0} {
  1935.         bell
  1936.     }
  1937.     return
  1938.     } elseif {[llength $targets] > 1} {
  1939.     # Multiple possibles
  1940.     if {[string length $f] == 0} {
  1941.         return
  1942.     }
  1943.     set t0 [lindex $targets 0]
  1944.     for {set len [string length $t0]} {$len>0} {} {
  1945.         set allmatch 1
  1946.         foreach s $targets {
  1947.         if {![string equal -length $len $s $t0]} {
  1948.             set allmatch 0
  1949.             break
  1950.         }
  1951.         }
  1952.         incr len -1
  1953.         if {$allmatch} break
  1954.     }
  1955.     set f [string range $t0 0 $len]
  1956.     }
  1957.  
  1958.     if {$data(-multiple)} {
  1959.     set f [list $f]
  1960.     }
  1961.     $data(ent) delete 0 end
  1962.     $data(ent) insert 0 $f
  1963.     return -code break
  1964. }
  1965.